home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Almathera Ten Pack 3: CDPD 3
/
Almathera Ten on Ten - Disc 3: CDPD3.iso
/
ab20
/
ab20_archive
/
datacomm
/
vlt-5.045.lzh
/
rexx
/
VLT2Provec.pvrx
< prev
next >
Wrap
Text File
|
1991-02-04
|
9KB
|
359 lines
/** VLT2Provec.pvrx
*
* This routine takes a VLT command file containing "Tek...." commands
* and translates them to instructions for Provector. This routine
* must be called from Provector using "Rexxecute", or you may add it
* as a menu option.
*
* The VLT command file is prepared by selecting the VLT option
* "Save as Script Commands" option from the Image menu of the the
* VLT graphics screen.
*
* When you run this routine from Provector, it will ask you for a file
* name. It will then start translating the commands and occasionally it
* will update the screen. Depending on the complexity of the plot, this
* may take some time.
*
* Currently, not every VLT command is handled completely/correctly.
* Some commands are not implemented. If you find you need to make some
* enhancements, go right ahead!
*
* Willy Langeveld, 4 February 1991.
*
**/
OPTIONS results
address 'ProVector'
/*
* Get the file name and open it
*/
'GetStr "VLT command file to import:" "OK" "Abort"'
file = result
if ~open("INFILE",file) then do
'GetBool "Couldn''t open file" "OK" "Eyup"'
exit 0
end
/*
* Set page dimensions
*/
pdims.x1 = 0
pdims.y2 = 0
pdims.x2 = 8.5
pdims.y1 = 8.5
'SetPageSize' pdims
/*
* Scale factors.
*/
xscale = 8.5/4096
yscale = 8.5/4096
/*
* Make a background object
*/
pts.0.x = 0
pts.0.y = 0
pts.1.x = 0
pts.1.y = 8.5
pts.2.x = 8.5
pts.2.y = 8.5
pts.3.x = 8.5
pts.3.y = 0
'Polygon' 4 pts
BackGround = result
'ChangeFillVal ' BackGround 0
'ChangeEdgeType ' BackGround 0
/*
* Initialize some variables
* Picture. contains the attributes that we can't set immediately.
*/
Picture. = ""
Picture.Linepen = 1
Picture.Textpen = 1
/*
* npts is the number of points in the pts. array.
*/
npts = 0
/*
* LineMode = 1 means we're drawing a line object
* LineMode = 2 means we're drawing a filled object
*/
LineMode = 1
/*
* Some marker types. This really needs to be improved, but then,
* who uses markers anyway...
*/
MarkerTypes.0 = "."
MarkerTypes.1 = "."
MarkerTypes.2 = "+"
MarkerTypes.3 = "*"
MarkerTypes.4 = "O"
MarkerTypes.5 = "X"
MarkerTypes.6 = "O"
MarkerTypes.7 = "O"
MarkerTypes.8 = "X"
MarkerTypes.9 = "X"
MarkerTypes.10 = "X"
/*
* Set the upper 128 colors to Tektronix colors
*/
do i = 1 to 5
do j = 1 to 5
do k = 1 to 5
rgb.r = i * 51
rgb.g = j * 51
rgb.b = k * 51
pen = (i-1) * 25 + (j-1) * 5 + k + 127
'SetColor ' pen rgb
end
end
end
/*
* Reset the timer
*/
call time('r')
/*
* Main loop over VLT's commands
*/
do i = 1 while ~eof("INFILE")
data = readln("INFILE")
parse var data 'Tek' cmd xx yy zz .
cmd = upper(cmd)
/*
* Every 5 seconds, fix the display
*/
if time('e') > 5 then do
'Repair'
call time('r')
end
/*
* We should finish up the current object if the command is not MOVE,
* DRAW or POLYGON. These do their own cleanups
*/
if (cmd ~= "MOVE") & (cmd ~= "DRAW") & (cmd ~= "POLYGON") then do
if npts ~= 0 then do
if LineMode = 1 then call DoPolyLine
else if LineMode = 2 then call DoPolygon
npts = 0
end
end
/*
* Now handle the commands. Some of them are quite weird...
* There are some we don't handle (they do a "nop").
*/
select
when cmd = "MOVE" then do
if LineMode = 1 then do
if npts ~= 0 then call DoPolyLine
pts.0.x = xx * xscale
pts.0.y = yy * yscale
npts = 1
end
else if LineMode = 2 then do
pts.npts.x = xx * xscale
pts.npts.y = yy * yscale
npts = npts + 1
end
end
when cmd = "DRAW" then do
pts.npts.x = xx * xscale
pts.npts.y = yy * yscale
npts = npts + 1
end
when cmd = "MARKER" then do
zz = Picture.MarkerType
call DoChar(1)
end
when cmd = "CHARACTER" then do
call DoChar(0)
end
when cmd = "ERASE" then do
nop
end
/*
* OLDMODE is no longer used by VLT, though it is still supported for
* old pictures. Note that there is some overlap between OLDMODE,
* MODE, PATTERN, and MODEPATTERN
*/
when cmd = "OLDMODE" then do
Picture.Linepen = xx
Picture.Textpen = xx
end
when cmd = "MODE" then do
if yy = 0 then Picture.Linepen = xx
else if yy = 1 then Picture.Textpen = xx
else if yy = 2 then do
Picture.Fillpen = xx // 256
Picture.Filltype = 1
if xx > 255 then do
if bittst(d2c(xx), 8) then Picture.Filltype = 2
else if bittst(d2c(xx), 9) then do
Picture.Filltype = 1
Picture.Fillpen = Picture.Fillpen + 128
end
else if bittst(d2c(xx), 10) then Picture.FillType = 0
end
end
else if yy = 3 then Picture.AluMode = xx
end
when cmd = "PATTERN" then do
Picture.Pattern = xx
end
when cmd = "MODEPATTERN" then do
Picture.Linepen = xx
Picture.Pattern = yy
end
when cmd = "INIT" then do
nop
end
/*
* Here we decode the color values. Note that red and green are in the
* upper and lower nybbles of the yy value.
*/
when cmd = "COLOR" then do
rgb.r = yy / 16 % 1 * 17
rgb.g = yy // 16 * 17
rgb.b = zz * 17
'SetColor 'xx rgb
end
/*
* Like some other commands, POLYGON comes in two flavors distinguished
* by one of the args, here it's xx. Not correctly handled here is the
* case where there are "polygons within polygons".
*/
when cmd = "POLYGON" then do
if xx = 1 then do
if LineMode = 1 then do
if npts ~= 0 then call DoPolyLine
npts = 0
end
LineMode = 2
Picture.PolyOutline = yy
end
else if xx = 0 then do
if npts ~= 0 then call DoPolygon
npts = 0
LineMode = 1
end
end
when cmd = "TEXTJAM" then do
Picture.TextJAM = xx
end
when cmd = "TEXTSIZE" then do
Picture.TextSize.x = xx
Picture.TextSize.y = yy
Picture.TextSize.Space = zz
end
when cmd = "MARKERTYPE" then do
Picture.MarkerType = MarkerTypes.xx
end
when cmd = "TEXTPATHANGLE" then do
if yy = 0 then Picture.TextAngle = xx
else if yy = 1 then Picture.TextPath = xx
end
when cmd = "BACKGROUNDCOLOR" then do
'ChangeFillVal ' BackGround xx
end
when cmd = "SETWINDOW" then do
if zz = 1 then do
Picture.Corner.1.x = xx
Picture.Corner.1.y = yy
xscale = 8.5/(Picture.Corner.1.x - Picture.Corner.0.x + 1)
yscale = xscale
end
else if zz = 0 then do
Picture.Corner.0.x = xx
Picture.Corner.0.y = yy
end
end
when cmd = "GRAPHCHAR" then do
call DoChar(1)
end
/*
* We don't handle PIXEL operations yet.
*/
when cmd = "PIXELRECT" then do
nop
end
when cmd = "PIXELCOPY" then do
nop
end
when cmd = "PIXELWRITE" then do
nop
end
otherwise do
nop
end
end
end
/*
* We reached the end of file. Have to finish current object
*/
if npts ~= 0 then do
if LineMode = 1 then call DoPolyLine
else if LineMode = 2 then call DoPolygon
end
/*
* Final repair
*/
'Repair'
address command 'say "I am Finished"'
call delay(50)
address command 'say "I said, I am Done"'
exit
/**
*
* Finish up a line object
*
**/
DoPolyLine:
'PolyLine' npts pts
object = result
'ChangeEdgeVal ' object Picture.Linepen
return
/**
*
* Finish up a polygon object
*
**/
DoPolygon:
'Polygon' npts pts
object = result
'ChangeFillType ' object Picture.Filltype
'ChangeFillVal ' object Picture.Fillpen
'ChangeEdgeType ' object Picture.PolyOutline
return
/**
*
* Display a character
*
**/
DoChar:
arg graph
width = Picture.TextSize.x * xscale
height = Picture.TextSize.y * yscale
if graph = 1 then angle = Picture.TextAngle
else angle = 0
'Text ' '"'d2c(zz)'"' xx*xscale yy*yscale width height angle
textobj = result
/*
* Change the string to the desired font
* Reflect to handle change in default coordinate system
* Then replot the changes
* Here we hit a provector bug if the pagesize is too big
*/
'ChangeFont ' textobj ' simple_stroke'
'Size ' textobj xx*xscale yy*yscale ' 1 -1'
'ChangeEdgeVal ' textobj Picture.Textpen
return